
#############################################################################
## $Id: Metadata.pm 15617 2013-04-01 21:55:40Z spadkins $
#############################################################################

package Devel::Metadata;
$VERSION = do { my @r=(q$Revision: 15617 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r};

use strict;

=head1 NAME

Devel::Metadata - programmatic access to metadata for Perl code (Distributions, Modules, Classes, Methods, etc.)

=head1 SYNOPSIS

   use Devel::Metadata;

   # public usage (perl metadata)
   $dmd = Devel::Metadata->new();

   @distributions = $dmd->distributions(); # get all installed distributions

   @modules = $dmd->modules();             # get all installed modules
   @modules = $dmd->modules("SOAP-Lite");  # get modules for a distribution
   $modules_def = $dmd->module_def("CGI"); # get module metadata (hashref)

   @packages = $dmd->packages("CGI");      # get packages defined in a module
   $package_def = $dmd->package_def("CGI",); # get package metadata (hashref)

   @subroutines = $dmd->subroutines("CGI");    # get subroutines/methods in a package
   $subroutine_def = $dmd->subroutine_def("CGI","param"); # subroutine metadata (hashref)

   @signatures = $dmd->signatures("CGI","param"); # signatures for a subroutine/method

   # protected usage
   print $dmd->dump(), "\n";   # use Data::Dumper to spit out the Perl representation
   $dmd->print();              # same as above
   $value = $dmd->get($property_name);
   $branch = $dmd->get_branch($branch_name,$create_flag);  # get hashref
   $dmd->set($property_name, $value);

=head1 DESCRIPTION

Devel::Metadata allows you to access metadata about the perl modules (.pm)
and perl libraries (.pl) you have installed on your system.

This module was created to support the needs of the Devel::Perldocs
code documentation generator.  However, the task of retrieving the
metadata (Devel::Metadata) is separated from the presentation of this
metadata (Devel::Perldocs) in order that the metadata may be used in
other circumstances.  These might include runtime parameter checking,
runtime checking of the existence of required modules,
or other uses of metadata at runtime or during code analysis.

Because metadata may be coded in POD documentation within a module,
Devel::Metadata also helps you create and maintain this special
POD documentation.  Thus, even without Devel::Perldocs, Devel::Metadata
plays a valuable role in documentation.

=head1 BACKGROUND

=head2 REQUIREMENTS

The module must drop into an existing Perl installation (Perl 5.5.3/5.005_03 or later)
and be able to report accurately on the distributions and modules/libraries/classes
(along with their subroutines/methods and corresponding signatures) that are
installed on the system.

The module must be fast enough to make it reasonable to query metadata at program
runtime, not just offline during code analysis for tasks such as documentation
generation.

The module must allow that supplementary metadata may be supplied inside the
code (specially tagged comments and specially tagged POD sections) and outside
the code (external metadata files).  This is because the Perl language is so
flexible that the metadata about method/subroutine signatures may be difficult
or impossible to discern without an extensive analysis of the code.

The module must help the developer create and maintain the POD documentation
within his code.

=head2 USE CASES

1. For the site (as defined by a particular @INC path, perhaps as supplemented by
PERL5LIB or PERLLIB), tell me:

   * What are the distributions (i.e. from CPAN) installed on the system?

2. For each distribution,

   * Which other distributions does each distribution depend on?
   * What attributes can be known about distributions? (version? date installed? author?)
   * What are the files (.pl, .pm, .pod, .xs/.al) within each distribution?

3. For each module/library,

   * What attributes can be known about each module/library? (version? is class? author?)
   * What are the subroutines are imported automatically? possibly?
   * What are the subroutines/methods in a library/module?
   * What are the parent (inherited) classes/modules of each class/module?
   * What are the child (derived) classes/modules of each class/module?
   * Which modules use which other modules? requiring which version numbers?
   * Are exceptions thrown? Which ones?

4. For each subroutine/method,

   * What are the possible signatures of each subroutine/method?
   * What attributes can be known about a subroutine? (version introduced?)
   * Are exceptions thrown? Which ones?

5. The above analysis of code must also be possible on a single directory of
modules under examination (as opposed to *all* modules installed in the
system). 

6. The code analysis may also span any subset of distributions found in the
current installation.

7. After analyzing some module(s), report on any discrepancies detected
between the metadata as determined by any of the various methods.

8. After analyzing some module(s), add correctly formatted POD documentation
to those modules.  This allows a developer who has quickly created some
code to put all of the easily determined POD documentation sections into
the code.  He can then examine it, add to it, and modify it.
This also allows for reasonably advanced documentation to be created
using the developer's own pod2xxx tools (not necessarily Devel::Perldocs).

9. After analyzing some module(s), update correctly formatted POD documentation
to those modules.  This allows a developer who has modified some code to 
check to see if any of the documentation sections is out of date and helps
to keep it accurate.

=head2 PRIOR WORK

A variety of modules exist which have tackled various parts of this problem
or related problems.

1. Modinfo

 http://sourceforge.net/projects/modinfo

ModInfo provides a simple means of documenting your Perl module interfaces,
and an easy way of using that documentation at runtime or design time.
The information provided is modelled after BeanInfo for Java Beans.

ModInfo requires the use of numerous "# MODINFO" comments within the code.
It is not able to report on code which has not been prepared in this way.
It may (?) allow for external metadata files to supplement the metadata
which is embedded in the code (via the special comments).
It caches this metatdata so that it is suitable for runtime use.

2. Module::Info

 http://search.cpan.org/author/MBARBON/Module-Info/lib/Module/Info.pm

Module::Info is the most extensive analyzer of metadata for raw perl code
which has had no specially tagged comments added.  It can report a few
elements of metadata about a module without loading it.  However, most of
the interesting information (subroutines and inheritance) can only be
determined after the module is loaded.  The modules get loaded in a
separate process, which is good for keeping your perl program unpolluted
but bad for runtime performance.

Module::Info requires Perl 5.6.1 and has no ability to determine
subroutine/method signatures.  However, in many ways it is more reliable
than source scanning because it actually examines the Perl symbol table.
It also provides no means of determining what are the installed distributions
(from CPAN) or what the modules are that are in those distributions.

3. Attribute::Signature

 http://search.cpan.org/author/JDUNCAN/Attribute-Signature/lib/Attribute/Signature.pm

This module allows for a module author to specify the signature of a
subroutine explicitly so that it is enforced by the Perl interpreter.
It requires Perl 5.6.1.  It does not provide any way for an external
program to determine what that signature is (such as for documentation).

=head2 DESIGN

The Devel::Metadata module should have the following design.

 * collect metadata from a variety of sources
   * report on conflicts or agreement
   * save metadata in a cache
 * report metadata from cache when requested (for performance)
 * metadata sources include:
   * raw source, scanned as a first approximation
   * specially tagged POD documentation supplements metadata for new code
   * specially tagged comments also supplement metadata for new code
   * external metadata files supplement metadata for legacy code
   * Module::Info can be used to cross-check any of the other sources
   * CPAN or CVS (perhaps to derive version-related or author-related information)

=head2 METADATA DEFINITIONS

The following are definitions with regard to Perl metadata.

=over 4

=item Perl Site

- an entire perl site, defined by a list of directories to be searched
in order for perl modules.  The default perl site is defined by the set
of directories in @INC, displayed with the following command (in
between square brackets): [perl -e 'print "@INC\n";'].  This search
path is potentially supplemented by the PERL5LIB and PERLLIB
environment variables. 

Note that there may be multiple (possibly overlapping) Perl Sites on
any given machine.  This might happen if the standard perl modules
are installed in "/usr/local/lib/perl5" but various versions of
application perl modules exist in other directories such as
"/usr/app/devel/lib", "/usr/app/1.0.3/lib", "/usr/app/2.0.0/lib", etc.

=item Perl Subsite

- within an entire perl site, there may be a subset of those directories
which are the target for code analysis.  This is called a Perl Subsite.
Only distributions from the Subsite are returned by the 
$dmd->distributions() method.  This is useful when you wish to 
analyze only a limited set of modules or distributions (Subsite)
within the context of the greater Site.

=item Distribution

- a group of files such as would be downloaded from CPAN which are
tested and installed together.  Each Distribution has a "name",
"version", "modules" list, "libraries" list, "files" list of all
files in the distribution, and special file lists of
"autoload_files", "shlib_files", and "man_files".

=item Library

- a file ending in ".pl" ([p]erl [l]ibrary) which can be loaded with
the [require "libraryname.pl";] statement. (This is mainly a 
feature from Perl 4.  Perl Libraries are generally replaced with
Perl Modules in Perl 5.)

=item Module

- a file ending in ".pm" ([p]erl [m]odule) which can be loaded with
the [use ModuleName;] statement.  (See "man perlmod" for more on
perl modules.)
Each Module is in a single Distribution.  If that 
Distribution is not known, it is assigned to the "unknown" Distribution.
A Module may be documented in its own ".pm" file or (additionally)
in an accompanying ".pod" file.
Most Modules defined subroutines (and perhaps variables) in a single
Package and often implement Classes, but this is not necessary.

=item Module Group

- some distributions are large and contain many modules which are
logically separated into different groups.  These groups are
inferred by the directory structure within the distribution.
Each directory represents a Module Group.  If a Module exists
with the same name as a directory, it belongs in the same
Module Group. (i.e. CPAN and CPAN::Admin are in the same Module Group.)

=item Package

- a perl symbol namespace which is often unique to a particular Module.
(see the "package" keyword in the "perlfunc" man page.)
Sometimes a single Module will load Subroutines for multiple Packages.
It is possible (but rare) that a Package may have Subroutines defined
for it from multiple Modules.

=item Subroutine

- a subroutine is technically in a Package, not a Module.
However, it is most often defined in that Package as the result
of loading a Module.
Each Subroutine in perl can have many Signatures.

=item Signature

- a Signature for a Subroutine is a set of Parameters that define
a manner in which the Subroutine may be called.  There are always
one or more Signatures for each Subroutine.

=item Parameter

- a Parameter to a Subroutine has a name, a type, and a description,
and an indicator whether it is readonly ("in"), whether it
or its referenced contents are simply to be returned ("out"),
or whether it or its referenced contents may be examined and
then modified ("in/out").

=item Class

- a special kind of Package which has been written to facilitate
object-oriented programming.
(See perlboot, perltoot, perltootc, perlobj, perlbot.)
In order for a
Module to be a Class, it must have a constructor, and its subroutines
must be callable with the first argument used in the special way
which make them "Methods".

=item Method

- a special kind of Subroutine which has been written to facilitate
object-oriented programming.  If the first argument is expected
to be the class name (package name), the method is usually referred
to as a Class Method (or Static Method) to differentiate it from
the usual usage of "Method" as an Instance Method. 
If the first argument is 
expected to be an instance of the class, it is usually referred
simply as a Method (but sometimes by the more verbose
Instance Method, Object Method, or Dynamic Method).

=back 4

=head1 METADATA DICTIONARY

The metadata to be gleaned from the source code is as follows.

   # Distribution Files
   $self->{distfile}{$distfile}{distribution}

   # Distributions
   $self->{distribution}{$distribution}
   $self->{distribution}{$distribution}{version}
   $self->{distribution}{$distribution}{modules}
   $self->{distribution}{$distribution}{libraries}
   $self->{distribution}{$distribution}{files}
   $self->{distribution}{$distribution}{autoload_files}
   $self->{distribution}{$distribution}{shlib_files}
   $self->{distribution}{$distribution}{man_files}
  
   # Modules
   $self->{module}{$module}
   $self->{module}{$module}{distribution}
   $self->{module}{$module}{pmfile}
   $self->{module}{$module}{podfile}
   $self->{module}{$module}{modulegroup}
   $self->{module}{$module}{name}
   $self->{module}{$module}{synopsis}
   $self->{module}{$module}{description}
   $self->{module}{$module}{throws}
   $self->{module}{$module}{since}
   $self->{module}{$module}{deprecated_since}
   $self->{module}{$module}{deprecated_discontinue}
   $self->{module}{$module}{authors}
   $self->{module}{$module}{author}{$author}{email}
   $self->{module}{$module}{license}
   $self->{module}{$module}{see_also}
   # Modules (object-oriented)
   $self->{module}{$module}{class}
   $self->{module}{$module}{parent}
   $self->{module}{$module}{parents}
   $self->{module}{$module}{children}
  
   # Subroutines (Methods)
   $self->{module}{$module}{subroutine}{$subroutine}
   $self->{module}{$module}{subroutine}{$subroutine}{doc}
   $self->{module}{$module}{subroutine}{$subroutine}{visibility}
   $self->{module}{$module}{subroutine}{$subroutine}{signatures}
   $self->{module}{$module}{subroutine}{$subroutine}{param}{$param}
   $self->{module}{$module}{subroutine}{$subroutine}{param}{$param}{type}
   $self->{module}{$module}{subroutine}{$subroutine}{param}{$param}{inout}
   $self->{module}{$module}{subroutine}{$subroutine}{return}{$return}
   $self->{module}{$module}{subroutine}{$subroutine}{return}{$return}{type}
   $self->{module}{$module}{subroutine}{$subroutine}{throws}
   $self->{module}{$module}{subroutine}{$subroutine}{since}
   $self->{module}{$module}{subroutine}{$subroutine}{deprecated_since}
   $self->{module}{$module}{subroutine}{$subroutine}{deprecated_discontinue}

   $self->{modulegroup}{$modulegroup}
   $self->{modulegroup}{$modulegroup}{modules}
  
=cut

#############################################################################
# CONSTRUCTOR METHODS
#############################################################################

=head1 Constructor Methods:

=cut

#############################################################################
# new()
#############################################################################

=head2 new()

This constructor is used to create Reference objects.
Customized behavior for a particular type of Reference
is achieved by overriding the init() method.

    * Signature: $dmd = Devel::Metadata->new($array_ref)
    * Signature: $dmd = Devel::Metadata->new($hash_ref)
    * Signature: $dmd = Devel::Metadata->new("array",@args)
    * Signature: $dmd = Devel::Metadata->new(%named)
    * Param:     $array_ref          []
    * Param:     $hash_ref           {}
    * Return:    $dmd                Devel::Metadata
    * Throws:    <none>
    * Since:     0.01

    Sample Usage:

    use "Devel::Metadata";

    $dmd = Devel::Metadata->new("array", "x", 1, -5.4, { pi => 3.1416 });
    $dmd = Devel::Metadata->new( [ "x", 1, -5.4 ] );
    $dmd = Devel::Metadata->new(
        arg1 => 'value1',
        arg2 => 'value2',
    );

=cut

sub new {
    my $this = shift;
    my ($class, $self);
    $class = ref($this) || $this;

    if ($#_ == 0 && ref($_[0]) eq "HASH") {
        $self = { %{$_[0]} };
    }
    elsif ($#_ >= 1 && $#_ % 2 == 1) {
        $self = { @_ };
    }
    else {
        $self = {};
    }

    bless $self, $class;
    return $self;
}

#############################################################################
# PUBLIC METHODS
#############################################################################

=head1 Public Methods:

=cut

#############################################################################
# distributions()
#############################################################################

=head2 distributions()

    * Signature: @distributions = $dmd->distributions();
    * Param:     void
    * Return:    @distributions    @      
    * Throws:    <none>
    * Since:     0.01

    Sample Usage: 

    @distributions = $dmd->distributions();
    print join("\n", sort @distributions), "\n";

=cut

sub distributions {
    my ($self) = @_;
    $self->_scan_site() if (!$self->{site_scanned});
    my @distributions = ();
    if ($self->{distribution}) {
        @distributions = (keys %{$self->{distribution}});
    }
    return @distributions;
}

#############################################################################
# modules()
#############################################################################

=head2 modules()

    * Signature: @modules = $dmd->modules();
    * Param:     void
    * Return:    @modules    @      
    * Throws:    <none>
    * Since:     0.01

    Sample Usage: 

    @modules = $dmd->modules();
    print join("\n", sort @modules), "\n";

=cut

sub modules {
    my ($self, $distribution) = @_;
    $self->_scan_site() if (!$self->{site_scanned});
    $distribution = "all" if (!$distribution);
    my @modules = ();
    if ($self->{distribution}{$distribution}{modules}) {
        @modules = @{$self->{distribution}{$distribution}{modules}};
    }
    return @modules;
}

#############################################################################
# module_def()
#############################################################################

=head2 module_def()

    * Signature: $module_def = $dmd->module_def($module);
    * Param:     $module        string
    * Return:    $module_def    {}
    * Throws:    <none>
    * Since:     0.01

    Sample Usage: 

    $module_def = $dmd->module_def($module);
    print "$module ", join(",", %$module_def), "\n";

=cut

sub module_def {
    my ($self, $module) = @_;

    $self->_scan_site() if (!$self->{site_scanned});
    return({}) if (!$module || !defined $self->{module}{$module});

    my ($pmfile, $podfile);

    $pmfile = $self->{module}{$module}{pmfile};
    if ($pmfile && !$self->{file}{$pmfile}{scanned}) {
        $self->_scan_file($pmfile);
        $self->{file}{$pmfile}{scanned} = 1;
    }

    $podfile = $self->{module}{$module}{podfile};
    if ($podfile && !$self->{file}{$podfile}{scanned}) {
        $self->_scan_file($podfile);
        $self->{file}{$podfile}{scanned} = 1;
    }
    
    return ($self->{module}{$module});
}

#############################################################################
# write_module_ext_pod()
#############################################################################

=head2 write_module_ext_pod()

    * Signature: $dmd->write_module_ext_pod($module, $filename);
    * Param:     $module        string
    * Param:     $filename      string
    * Return:    void
    * Throws:    <none>
    * Since:     0.01

    Sample Usage: 

    $dmd->write_module_ext_pod($module, "$module.pod");

=cut

sub write_module_ext_pod {
    my ($self, $module, $dstfile) = @_;
    $self->write_module_pod($module,$dstfile);
}

#############################################################################
# write_module_pod()
#############################################################################

=head2 write_module_pod()

    * Signature: $dmd->write_module_pod($module, $filename);
    * Param:     $module        string
    * Param:     $filename      string
    * Return:    void
    * Throws:    <none>
    * Since:     0.01

    Sample Usage: 

    $dmd->write_module_pod($module, "$module.pod");

=cut

sub write_module_pod {
    my ($self, $module, $dstfile) = @_;

    $self->_scan_site() if (!$self->{site_scanned});

    my ($srcfile, $module_def, $src_age, $dst_age, @stat);
    $srcfile = $self->{module}{$module}{podfile};
    $srcfile = $self->{module}{$module}{pmfile} if (!$srcfile);
    if (!$srcfile) {
        $module_def = $self->module_def($module);
        $srcfile = $module_def->{podfile};
        $srcfile = $module_def->{pmfile} if (!$srcfile);
    }

    if ($srcfile && -f $srcfile) {
        if (-f $dstfile) {
            @stat = stat($srcfile);
            $src_age = $stat[9];
            @stat = stat($dstfile);
            $dst_age = $stat[9];
        }
        if (! -f $dstfile || $dst_age < $src_age) {
            system("cp -f $srcfile $dstfile");
            printf "Module %-60s - pod written\n", $module;
            #printf "   [$src_age] $srcfile\n";
            #printf "   [$dst_age] $dstfile\n";
        }
        else {
            #printf "Module %-60s - pod current\n", $module;
        }
    }
    else {
        printf "Module %-60s - no source file found\n", $module;
    }

    #local(*main::FILE);
    #if (open(main::FILE, "> $dstfile")) {
    #    close(main::FILE);
    #}
    #else {
    #    print "Unable to open file [$dstfile]: $!\n";
    #}
}

#############################################################################
# PROTECTED METHODS
#############################################################################

=head1 Protected Methods:

The following methods are intended to be called only by this class and
other classes intimately related to this class.

=cut

#############################################################################
# get()
#############################################################################

=head2 get()

    * Signature: $property_value = $dmd->get($property_name);
    * Param:     $property_name    string
    * Return:    $property_value   string
    * Throws:    <none>
    * Since:     0.01

    Sample Usage: 

    $dbi    = $dmd->get("module.Devel::Metadata.dbi");
    $dbuser = $dmd->get("module.Devel::Metadata.dbuser");
    $dbpass = $dmd->get("module.Devel::Metadata.dbpass");

=cut

sub get {
    print "get(@_)\n" if ($Devel::Metadata::DEBUG);
    my ($self, $property_name, $dmd) = @_;
    $dmd = $self if (!defined $dmd);
    if ($property_name =~ /^(.*)([\.\{\[])([^\.\[\]\{\}]+)([\]\}]?)$/) {
        my ($branch_name, $attrib, $type, $branch);
        $branch_name = $1;
        $type = $2;
        $attrib = $3;
        $branch = ref($dmd) eq "ARRAY" ? undef : $dmd->{_branch}{$branch_name};
        $branch = $self->get_branch($1,0,$dmd) if (!defined $branch);
        return undef if (!defined $branch || ref($branch) eq "");
        return $branch->[$attrib] if (ref($branch) eq "ARRAY");
        return $branch->{$attrib};
    }
    else {
        return $self->{$property_name};
    }
}

#############################################################################
# get_branch()
#############################################################################

=head2 get_branch()

    * Signature: $branch = $dmd->get_branch($branch_name);
    * Param:     $branch_name  string
    * Return:    $branch       {}
    * Throws:    <none>
    * Since:     0.01

    Sample Usage: 

    $branch_name = "module.Devel::Metadata";
    $branch = $dmd->get_branch($branch_name);
    foreach $key (keys %$branch) {
        $property = "${branch_name}.${key}";
        print $property, "=", $branch->{$key}, "\n";
    }
    $dbi    = $branch->{dbi};
    $dbuser = $branch->{dbuser};
    $dbpass = $branch->{dbpass};

=cut

sub get_branch {
    print "get_branch(@_)\n" if ($Devel::Metadata::DEBUG);
    my ($self, $branch_name, $create, $dmd) = @_;
    my ($sub_branch_name, $branch_piece, $attrib, $type, $branch, $cache_ok);
    $dmd = $self if (!defined $dmd);

    # check the cache quickly and return the branch if found
    $cache_ok = (ref($dmd) ne "ARRAY" && $dmd eq $self); # only cache from $self
    $branch = $dmd->{_branch}{$branch_name} if ($cache_ok);
    return ($branch) if (defined $branch);

    # not found, so we need to parse the $branch_name and walk the $dmd tree
    $branch = $dmd;
    $sub_branch_name = "";

    # these: "{field1}" "[3]" "field2." are all valid branch pieces
    while ($branch_name =~ s/^([\{\[]?)([^\.\[\]\{\}]+)([\.\]\}]?)//) {

        $branch_piece = $2;
        $type = $3;
        $sub_branch_name .= ($3 eq ".") ? "$1$2" : "$1$2$3";

        if (ref($branch) eq "ARRAY") {
            if (! defined $branch->[$branch_piece]) {
                if ($create) {
                    $branch->[$branch_piece] = ($type eq "]") ? [] : {};
                    $branch = $branch->[$branch_piece];
                    $dmd->{_branch}{$sub_branch_name} = $branch if ($cache_ok);
                }
                else {
                    return(undef);
                }
            }
            else {
                $branch = $branch->[$branch_piece];
                $sub_branch_name .= "$1$2$3";   # accumulate the $sub_branch_name
            }
        }
        else {
            if (! defined $branch->{$branch_piece}) {
                if ($create) {
                    $branch->{$branch_piece} = ($type eq "]") ? [] : {};
                    $branch = $branch->{$branch_piece};
                    $dmd->{_branch}{$sub_branch_name} = $branch if ($cache_ok);
                }
                else {
                    return(undef);
                }
            }
            else {
                $branch = $branch->{$branch_piece};
            }
        }
        $sub_branch_name .= $type if ($type eq ".");
    }
    return $branch;
}

#############################################################################
# set()
#############################################################################

=head2 set()

    * Signature: $dmd->get($property_name, $property_value);
    * Param:     $property_name    string
    * Param:     $property_value   string
    * Throws:    <none>
    * Since:     0.01

    Sample Usage: 

    $dbi    = $dmd->get("module.Devel::Metadata.dbi");
    $dbuser = $dmd->get("module{Devel::Metadata}{dbuser}");
    $dbpass = $dmd->get("module.Devel::Metadata{dbpass}");

=cut

sub set {
    print "set(@_)\n" if ($Devel::Metadata::DEBUG);
    my ($self, $property_name, $property_value, $dmd) = @_;
    $dmd = $self if (!defined $dmd);

    my ($branch_name, $attrib, $type, $branch, $cache_ok);
    if ($property_name =~ /^(.*)([\.\{\[])([^\.\[\]\{\}]+)([\]\}]?)$/) {
        $branch_name = $1;
        $type = $2;
        $attrib = $3;
        $cache_ok = (ref($dmd) ne "ARRAY" && $dmd eq $self);
        $branch = $dmd->{_branch}{$branch_name} if ($cache_ok);
        $branch = $self->get_branch($1,1,$dmd) if (!defined $branch);
    }
    else {
        $branch = $dmd;
        $attrib = $property_name;
    }

    if (ref($branch) eq "ARRAY") {
        $branch->[$attrib] = $property_value;
    }
    else {
        $branch->{$attrib} = $property_value;
    }
}

#############################################################################
# dump()
#############################################################################

=head2 dump()

    * Signature: $perl = $dmd->dump();
    * Param:     void
    * Return:    $perl      text
    * Throws:    <none>
    * Since:     0.01

    Sample Usage: 

    $dmd = $context->config();
    print $dmd->dump(), "\n";

=cut

use Data::Dumper;

sub dump {
    my ($self) = @_;
    my $d = Data::Dumper->new([ $self ], [ "conf" ]);
    $d->Indent(1);
    return $d->Dump();
}

#############################################################################
# print()
#############################################################################

=head2 print()

    * Signature: $dmd->print();
    * Param:     void
    * Return:    void
    * Throws:    <none>
    * Since:     0.01

    Sample Usage: 

    $context->print();

=cut

sub print {
    my $self = shift;
    print $self->dump();
}

#############################################################################
# PRIVATE METHODS
#############################################################################

=head1 Private Methods:

The following methods are intended to be called only within this class.

=cut

#############################################################################
# _scan_site()
#############################################################################

=head2 _scan_site()

    * Signature: $dmd->_scan_site();
    * Param:     void
    * Return:    void
    * Throws:    <none>
    * Since:     0.01

    Sample Usage: 

    $dmd->_scan_site();

=cut

sub _scan_site {
    my ($self) = @_;
    my (@inc, $inc, $dist, $dist_def, $distfile_def, $module, $file);
    @inc = @INC;
    if ($ENV{PATH} =~ m/(.*)/) {
        $ENV{PATH} = $1;
    }
    foreach $inc (@INC) {
        next if (! -d $inc);

        # TODO: replace this with the Perl version of "find" someday
        my (@distfiles, $distfile, $tmpdir);
        open (FIND, "find $inc -name '.packlist' -print |") || die "Unable to get file list: $!\n";
        @distfiles = <FIND>;
        close(FIND);
        chomp(@distfiles);

        # Search through each distribution file
        foreach $distfile (@distfiles) {

            next if (defined $self->{distfile}{$distfile});
            $distfile_def = {};
            $self->{distfile}{$distfile} = $distfile_def;

            $dist = $self->distfile2dist($distfile);
            next if (!$dist);  # not a distribution file!
            next if (defined $self->{distribution}{$dist});
            $dist_def = {};
            $self->{distribution}{$dist} = $dist_def;
            $dist_def->{files} = [];
            $dist_def->{modules} = [];

            foreach $file (split(/\n/,$self->_read_file($distfile))) {
                if ($file =~ /\.pm$/) {
                    next if ($file =~ m!$inc/site_perl!);
                    next if ($file =~ m!$inc.*/5\.[0-9\.]{3,}/!);
                    next if ($file =~ m!$inc/[a-z][^/]+-[^/]+/!);
                    next if ($file =~ m!$inc/\.perldocs!);

                    $module = $self->file2module($file, $inc);
                    next if ($module !~ /^([A-Z][A-Za-z0-9_]*::)*[A-Za-z][A-Za-z0-9_]*$/);

                    if (! defined $self->{module}{$module}{pmfile}) {
                        $self->{module}{$module}{pmfile} = $file;
                    }
                    if (! defined $self->{module}{$module}{distribution}) {
                        $self->{module}{$module}{distribution} = $dist;
                    }

                    if (!$dist_def->{module}{$module}) {
                        $dist_def->{module}{$module} = 1;
                        push(@{$dist_def->{modules}}, $module);
                    }
                    if (!$self->{distribution}{all}{module}{$module}) {
                        $self->{distribution}{all}{module}{$module} = 1;
                        push(@{$self->{distribution}{all}{modules}}, $module);
                    }

                    if (!$dist_def->{file}{$file}) {
                        $dist_def->{file}{$file} = 1;
                        push(@{$dist_def->{files}}, $file);
                        $self->{file}{$file}{module} = $module;
                    }
                    if (!$self->{distribution}{all}{pmfile}{$file}) {
                        $self->{distribution}{all}{pmfile}{$file} = 1;
                        push(@{$self->{distribution}{all}{files}}, $file);
                    }
                }
                elsif ($file =~ /\.pod$/) {
                }
                elsif ($file =~ /\.al$/) {
                }
                elsif ($file =~ /\/man[1-9]\//) {
                }
            }
        }

        # replace this with the Perl version of "find" someday
        my (@podfiles, $podfile);
        open (FIND, "find $inc -name '*.pod' -print |") || die "Unable to get file list: $!\n";
        @podfiles = <FIND>;
        close(FIND);
        chomp(@podfiles);

        # Search through each POD file
        foreach $podfile (@podfiles) {
            next if ($podfile =~ m!$inc/site_perl!);
            next if ($podfile =~ m!$inc.*/5\.[0-9\.]{3,}/!);
            next if ($podfile =~ m!$inc/[a-z][^/]+-[^/]+/!);
            next if ($podfile =~ m!$inc/\.perldocs!);

            $module = $self->file2module($podfile, $inc);
            next if ($module !~ /^(?:[A-Z][A-Za-z0-9_]*::)*[A-Za-z][A-Za-z0-9_]*$/x);

            if (! defined $self->{file}{$podfile}) {
                $self->{file}{$podfile} = {};
            }

            if (! defined $self->{module}{$module}{podfile}) {
                $self->{module}{$module}{podfile} = $podfile;
            }
            if (! defined $self->{module}{$module}{distribution}) {
                $self->{module}{$module}{distribution} = "unknown";
            }

            if (!$self->{distribution}{all}{module}{$module}) {
                $self->{distribution}{all}{module}{$module} = 1;
                push(@{$self->{distribution}{all}{modules}}, $module);
                $self->{distribution}{unknown}{module}{$module} = 1;
                push(@{$self->{distribution}{unknown}{modules}}, $module);
            }

            if (!$self->{distribution}{all}{file}{$podfile}) {
                $self->{distribution}{all}{file}{$podfile} = 1;
                push(@{$self->{distribution}{all}{files}}, $podfile);
                $self->{distribution}{unknown}{file}{$podfile} = 1;
                push(@{$self->{distribution}{unknown}{files}}, $podfile);
            }
        }

        # replace this with the Perl version of "find" someday
        my (@pmfiles, $pmfile);
        open (FIND, "find $inc -name '*.pm' -print |") || die "Unable to get file list: $!\n";
        @pmfiles = <FIND>;
        close(FIND);
        chomp(@pmfiles);

        # Search through each PM file
        foreach $pmfile (@pmfiles) {
            next if ($pmfile =~ m!$inc/site_perl!);
            next if ($pmfile =~ m!$inc.*/5\.[0-9\.]{3,}/!);
            next if ($pmfile =~ m!$inc/[a-z][^/]+-[^/]+/!);
            next if ($pmfile =~ m!$inc/\.perldocs!);

            $module = $self->file2module($pmfile, $inc);
            next if ($module !~ /^(?:[A-Z][A-Za-z0-9_]*::)*[A-Za-z][A-Za-z0-9_]*$/x);

            if (! defined $self->{file}{$pmfile}) {
                $self->{file}{$pmfile} = {};
            }

            if (! defined $self->{module}{$module}{pmfile}) {
                $self->{module}{$module}{pmfile} = $pmfile;
            }
            if (! defined $self->{module}{$module}{distribution}) {
                $self->{module}{$module}{distribution} = "unknown";
            }

            if (!$self->{distribution}{all}{module}{$module}) {
                $self->{distribution}{all}{module}{$module} = 1;
                push(@{$self->{distribution}{all}{modules}}, $module);
                $self->{distribution}{unknown}{module}{$module} = 1;
                push(@{$self->{distribution}{unknown}{modules}}, $module);
            }

            if (!$self->{distribution}{all}{file}{$pmfile}) {
                $self->{distribution}{all}{file}{$pmfile} = 1;
                push(@{$self->{distribution}{all}{files}}, $pmfile);
                $self->{distribution}{unknown}{file}{$pmfile} = 1;
                push(@{$self->{distribution}{unknown}{files}}, $pmfile);
            }
        }
    }
    $self->{site_scanned} = 1;
}

#############################################################################
# _scan_file()
#############################################################################

=head2 _scan_file()

    * Signature: $dmd->_scan_file($file);
    * Signature: $dmd->_scan_file($file, $module);
    * Param:     $file       string
    * Param:     $module     string
    * Return:    void
    * Throws:    <none>
    * Since:     0.01

    Sample Usage: 

    $dmd->_scan_file($file);

=cut

sub _scan_file {
    my ($self, $file, $module) = @_;
#print "_scan_file($file, $module): entry\n";
    $module = $self->file2module($file) if (!$module);

    my ($source, @source);
    @source = $self->_read_file($file);
    $source = \@source;

    $self->_scan_source_for_packages($file, $module, $source);
    $self->_scan_source_for_isa($file, $module, $source);
    #$self->_scan_source_for_subs($file, $module, $source);
    #$self->_scan_source_for_pod($file, $module, $source);

    $self->{file}{$file}{scanned} = 1;
#print "_scan_file(): exit\n";
}

sub _scan_source_for_packages {
    my ($self, $file, $module, $source) = @_;

    my ($lineidx, $lineno, $line, $package, @packages, %package_lines, $inpod);
    $package = "main";
    @packages = ();
    %package_lines = ();

    $inpod = 0;
    for ($lineidx = 0; $lineidx <= $#$source; $lineidx++) {
        $line = $source->[$lineidx];
        $lineno = $lineidx + 1;
        if ($inpod) {
            if ($line =~ /^=cut/) {
                $inpod = 0;
            }
            next;
        }
        else {
            if ($line =~ /^=/) {
                $inpod = 1;
                next;
            }
        }
        last if ($line =~ /^__/);  # i.e. __END__ or __DATA__
        if ($line =~ /^ *package +([A-Za-z0-9:_]+)/) {
            $package = $1;
            push(@packages, $package) if (!$package_lines{$package});
        }
        $package_lines{$package}++ if ($line !~ /^\s*$/ && $line !~ /^\s*#/);

    }
    if ($#packages == -1) {
        @packages = ("main");
    }
    $self->{module}{$module}{packages} = \@packages;
    $self->{module}{$module}{package_lines} = \%package_lines;
}

sub _scan_source_for_xyz { # standard template
    my ($self, $file, $module, $source) = @_;

    my ($lineidx, $lineno, $line, $package, $inpod);
    $package = "main";

    $inpod = 0;
    for ($lineidx = 0; $lineidx <= $#$source; $lineidx++) {
        $line = $source->[$lineidx];
        $lineno = $lineidx + 1;
        if ($inpod) {
            if ($line =~ /^=cut/) {
                $inpod = 0;
            }
            next;
        }
        else {
            if ($line =~ /^=/) {
                $inpod = 1;
                next;
            }
        }
        last if ($line =~ /^__/);  # i.e. __END__ or __DATA__
        if ($line =~ /^ *package +([A-Za-z0-9:_]+)/) {
            $package = $1;
        }
    }
}

sub _scan_source_for_isa {
    my ($self, $file, $module, $source) = @_;

    my ($lineidx, $lineno, $line, $package, $inpod);
    my ($parents, $parent, @parents, $isa_package);
    $package = "main";

    $inpod = 0;
    for ($lineidx = 0; $lineidx <= $#$source; $lineidx++) {
        $line = $source->[$lineidx];
        $lineno = $lineidx + 1;
        if ($inpod) {
            if ($line =~ /^=cut/) {
                $inpod = 0;
            }
            next;
        }
        else {
            if ($line =~ /^=/) {
                $inpod = 1;
                next;
            }
        }
        last if ($line =~ /^__/);  # i.e. __END__ or __DATA__
        if ($line =~ /^ *package +([A-Za-z0-9:_]+)/) {
            $package = $1;
        }

        if ($line =~ /\bISA\b/) {  # should be able to get inheritance here
            $isa_package = $package;
            if ($line =~ /([A-Za-z_:]+)::ISA/) {
                $isa_package = $1;
            }
            if ($line =~ /\bISA *= *([^;]+)/) {
                $parents = $1;
                @parents = ();
                if ($parents =~ /^qw *\(([^\)]+)\)/) {
                    $parents = $1;
                    $parents =~ s/^ +//;
                    $parents =~ s/ +$//;
                    foreach $parent (split(/ +/, $parents)) {
                        push(@parents, $parent) if ($parent =~ /^[A-Za-z0-9:_]+$/);
                    }
                }
                elsif ($parents =~ /^\(([^\)]+)\)/) {
                    $parents = $1;
                    $parents =~ s/^[ '"]+//;
                    $parents =~ s/[ '",]+$//;
                    $parents =~ s/[ '",]+/ /g;
                    foreach $parent (split(/ +/, $parents)) {
                        push(@parents, $parent) if ($parent =~ /^[A-Za-z0-9:_]+$/);
                    }
                }
                elsif ($parents =~ /^["']([A-Za-z0-9_:]+)["']/) {
                    $parents = $1;
                    @parents = ( $parents );
                }
                if ($#parents > -1) {
                    $self->{package}{$isa_package}{parent} = $parents[0];
                    $self->{package}{$isa_package}{parents} = \@parents;
                    foreach my $parent (@parents) {
                        if (! defined $self->{package}{$parent}{children}) {
                            $self->{package}{$parent}{children} = []
                        }
                        push(@{$self->{package}{$parent}{children}}, $isa_package);
                    }
                }
            }
        }
    }
}

sub _scan_source_for_subs {
    my ($self, $file, $module, $source) = @_;
}

sub _scan_source_for_pod {
    my ($self, $file, $module, $source) = @_;
}

sub file2shortfile {
    my ($self, $shortfile, $incdir) = @_;
    $shortfile =~ s!^$incdir!! if ($incdir); # remove leading dir known not to be part of module name
    $shortfile =~ s!site_perl/!!;            # remove site_perl
    $shortfile =~ s!.*/5\.[0-9\.]{3,}/!!;    # remove perl version
    $shortfile =~ s!^/!!;                    # remove leading "/"
    $shortfile =~ s!^[a-z][^/]+-[^/]+/!!;    # remove architecture string
    return $shortfile;
}

sub file2module {
    my ($self, $module, $incdir) = @_;
    $module =~ s!^$incdir!! if ($incdir); # remove leading dir known not to be part of module name
    $module =~ s!site_perl/!!;            # remove site_perl
    $module =~ s!.*/5\.[0-9\.]{3,}/!!;    # remove perl version
    $module =~ s!^/!!;                    # remove leading "/"
    $module =~ s!^[a-z][^/]+-[^/]+/!!;    # remove architecture string
    $module =~ s!^(?:[a-z]+/)+!!x;        # remove "lib", "blib", "pod", etc.
    $module =~ s!\.pm$!!;                 # remove .pm suffix
    $module =~ s!\.pod$!!;                # remove .pod suffix
    $module =~ s!/!::!g;                  # change dir separators to "::"
    return $module;
}

sub distfile2dist {
    my ($self, $dist, $incdir) = @_;
    return "" if ($dist !~ m!/auto/!);  # .packlist files should always have "/auto/" in the path
    $dist =~ s!.*/auto/!!;
    $dist =~ s!/\.packlist$!!;
    $dist =~ s!/!-!g;
    return $dist;
}

sub _read_file {
    my ($self, $file) = @_;
    local(*FILE);
    my ($data, @data);
    #print "Reading [$file] ...\n";
    if (open(FILE, "< $file")) {
        @data = <FILE>;
        close(FILE);
        return (@data) if (wantarray);
        $data = join("", @data);
        return ($data);
    }
    else {
        print "Failed to open file for reading [$file]: $!\n";
    }
    return("");
}

sub _write_file {
    my ($self, $file, $data) = @_;
    local(*FILE);
    if (open(FILE, "> $file")) {
        print FILE $data;
        close(FILE);
        #print "Writing [$file] ...\n";
    }
    else {
        print "Failed to open file for writing [$file]: $!\n";
    }
}

=head1 ACKNOWLEDGEMENTS

    * Author:  Stephen Adkins <spadkins@gmail.com>
    * License: This is free software. It is licensed under the same terms as Perl itself.

=head1 SEE ALSO

none

=cut

1;

__END__

    my (@package_frags, $pf, $package, $pfrag);
    my (@head_frags, $hf, $headlevel, $headtext, $hfrag);
    my (@sub_frags, $sf, $sub, $sfrag);
    my ($dist_name, $class_list, $class_group, $class, $description, $capability, $method);

    # search each package
    @package_frags = split(/(\npackage .*\n)/, $source);
    unshift(@package_frags, "package $module;");
    for ($pf = 0; $pf <= $#package_frags; $pf += 2) {

        if ($package_frags[$pf] =~ /^ *package +([A-Za-z0-9:_]+);/) {

            $package = $1;
            &docwarn("mfiup", $file, $package) if ($module ne $package);

            $pfrag = $package_frags[$pf+1];
            #print "package=[$package] pfrag=[$pfrag]\n";

            # save info about where this class (package) was detected
            $metadata->{classgroup}{all}{classes} = []
                if (! defined $metadata->{classgroup}{all}{classes});
            if (! defined $metadata->{classgroup}{all}{class}{$package}) {
                push(@{$metadata->{classgroup}{all}{classes}}, $package);
                $metadata->{classgroup}{all}{class}{$package} = {};
            }

            # take not of the module that POD for the package is in
            if ($pfrag =~ /\n=head1 /s) {
                $metadata->{class}{$package}{podclass} = $module;
            }

            # Scan the ISA list to get the inheritance tree
            if ($pfrag =~ /\@ISA *= *([^;#]*)/) {
                $class_list = $1;
                while ($class_list =~ /([A-Z][A-Za-z0-9_:]+)/g) {
                    $class = $1;
                    $metadata->{class}{$package}{parent} = $class
                        if (!defined $metadata->{class}{$package}{parent});
                    if (!defined $metadata->{class}{$package}{parents}) {
                        $metadata->{class}{$package}{parents} = []
                    }
                    else {
                        push(@{$metadata->{class}{$package}{parents}}, $class);
                    }
                    $metadata->{class}{$class}{children} = []
                        if (!defined $metadata->{class}{$class}{children});
                    push(@{$metadata->{class}{$class}{children}}, $package);
                }
            }

            # search each =head POD directive
            @head_frags = split(/(\n=head[12] .*\n)/, $pfrag);
            for ($hf = 1; $hf <= $#head_frags; $hf += 2) {
                if ($head_frags[$hf] =~ /=head([12]) +(.*)/) {
                    $headlevel = $1;
                    $headtext = $2;
                    $hfrag = $head_frags[$hf+1];
                    if ($headtext =~ /NAME/) {
                    }
                    elsif ($headtext =~ /SYNOPSIS/) {
                    }
                    elsif ($headtext =~ /DESCRIPTION/) {
                    }
                    elsif ($headtext =~ /ACKNOWLEDGEMENTS/) {
                    }
                    elsif ($headtext =~ /SEE ALSO/) {
                    }
                    elsif ($headtext =~ /Attributes, Constants, Global Variables, Class Variables/) {
                    }
                    elsif ($headtext =~ /Distribution: *(.*)/) {
                        $dist_name = $1;
                    }
                    elsif ($headtext =~ /Class Groups/) {
                        while ($hfrag =~ / \* Class Group: *([^-\n]+)( *\n *- *([^\n]+))?/sg) {
                            $class_group = $1;
                            $description = $3;
                            $class_group =~ s/[\|>].*//;
                            $class_group =~ s/.*<//;
                            $metadata->{classgroup}{$class_group}{description} = $description;
                        }
                    }
                    elsif ($headtext =~ /Class Group Requirements/) {
                    }
                    elsif ($headtext =~ /Class Group Design/) {
                    }
                    elsif ($headtext =~ /Class Group: *(.*)/) {
                        $class_group = $1;
                        $class_group =~ s/[\|>].*//;
                        $class_group =~ s/.*<//;
                        $metadata->{classgroup}{$class_group}{podclass} = $module;
                        while ($hfrag =~ / \* (Class|Document): *([^\n]+)/sg) {
                            $class = $2;
                            $class =~ s/[\|>].*//;
                            $class =~ s/.*<//;

                            $metadata->{classgroup}{$class_group}{classes} = []
                                if (! defined $metadata->{classgroup}{$class_group}{classes});
                            if (! defined $metadata->{classgroup}{$class_group}{class}{$class}) {
                                push(@{$metadata->{classgroup}{$class_group}{classes}}, $class);
                                $metadata->{classgroup}{$class_group}{class}{$class} = {};
                            }

                            $metadata->{classgroup}{all}{classes} = []
                                if (! defined $metadata->{classgroup}{all}{classes});
                            if (! defined $metadata->{classgroup}{all}{class}{$class}) {
                                push(@{$metadata->{classgroup}{all}{classes}}, $class);
                                $metadata->{classgroup}{all}{class}{$class} = {};
                            }
                        }
                    }
                    elsif ($headtext =~ /Class: *(.*)/) {
                        $class = $1;
                    }
                    elsif ($headtext =~ /Class Capabilities/) {
                    }
                    elsif ($headtext =~ /Class Requirements/) {
                    }
                    elsif ($headtext =~ /Class Design/) {
                    }
                    elsif ($headtext =~ /Constructor Methods: *(.*)/) {
                        $capability = $1;
                    }
                    elsif ($headtext =~ /Public Methods: *(.*)/) {
                        $capability = $1;
                    }
                    elsif ($headtext =~ /Public Methods: *(.*)/) {
                        $capability = $1;
                    }
                    elsif ($headtext =~ /Public Methods: *(.*)/) {
                        $capability = $1;
                    }
                    elsif ($headtext =~ / *(.+)\(\)/) {
                        $method = $1;
                        &docwarn("mdnh2", $file, $method) if ($headlevel != 2);
                        $hfrag =~ s/\nsub .*//s;
                        $metadata->{class}{$package}{method}{$method}{doc} = $hfrag;
                    }
                    else {
                    }
                    #print "headlevel=[$headlevel] headtext=[$headtext] hfrag=[$hfrag]\n";
                }
            }

            # search each subroutine/method definition
            @sub_frags = split(/(\nsub .*\n)/, $source);
            for ($sf = 1; $sf <= $#sub_frags; $sf += 2) {
                if ($sub_frags[$sf] =~ /sub +([A-Za-z0-9_]+)/) {
                    $method = $1;
                    $sfrag = $sub_frags[$sf+1]; # { {
                    $sfrag =~ s/\n}.*/}/s;
                    $metadata->{class}{$package}{method}{$method}{code} = $sfrag;
                    if (! defined $metadata->{class}{$package}{method}{$method}{doc}) {
                        &docwarn("mwnd", $file, $method);
                    }
                    #print "method=[$method] sfrag=[$sfrag]\n";
                }
            }
        }
    }
